knitr::opts_chunk$set(echo = TRUE)
knitr::opts_chunk$set(message = TRUE)
knitr::opts_chunk$set(warning = FALSE)
library(haven)
library(tidyverse)
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.3.6 ✔ purrr 0.3.5
## ✔ tibble 3.1.8 ✔ dplyr 1.0.10
## ✔ tidyr 1.2.1 ✔ stringr 1.4.1
## ✔ readr 2.1.3 ✔ forcats 0.5.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
library(dplyr)
library(ggplot2)
library(plotly)
##
## Attaching package: 'plotly'
##
## The following object is masked from 'package:ggplot2':
##
## last_plot
##
## The following object is masked from 'package:stats':
##
## filter
##
## The following object is masked from 'package:graphics':
##
## layout
#Data Import
dat2 <- read_sav("~/Desktop/Academics/PhD Research/U.S. RDE/2nd Run/AllData.sav")
dat2 <- dat2 %>%
rename(pro1 = "Q5",
pro2 = "Q6",
pro3 = "Q8",
pre1 = "Q11",
pre2 = "Q12",
pre3 = "Q13",
DV = "DVTotalAct") %>%
select(pro1, pro2, pro3, pre1, pre2, pre3,
Race_1, Race_2, Race_3, Race_4, Race_5, Race_6, Race_7, Race_8, Race_9,
Gender, Politics, SES, Condition, DV) %>%
mutate(Survey = 2)
#Data Import
dat4 <- read_sav("~/Desktop/Academics/PhD Research/U.S. RDE/Resonance:OMT Version/1st Study/AllDataOMT.sav")
dat4 <- dat4 %>%
rename(pro1 = "Q5",
pro2 = "Q6",
pro3 = "Q8",
pre1 = "Q11",
pre2 = "Q12",
pre3 = "Q13",
DV = "DVTotal") %>%
select(pro1, pro2, pro3, pre1, pre2, pre3,
Race_1, Race_2, Race_3, Race_4, Race_5, Race_6, Race_7, Race_8, Race_9,
Gender, Politics, SES, Condition, DV) %>%
mutate(Survey = 4)
dat5 <- read_sav("~/Desktop/Academics/PhD Research/U.S. RDE/Resonance:OMT Version/2nd Study/AllData.sav")
dat5 <- dat5 %>%
rename(pro1 = "Q5",
pro2 = "Q6",
pro3 = "Q8",
pre1 = "Q11",
pre2 = "Q12",
pre3 = "Q13",
DV = "DVTotal") %>%
select(pro1, pro2, pro3, pre1, pre2, pre3,
Race_1, Race_2, Race_3, Race_4, Race_5, Race_6, Race_7, Race_8, Race_9,
Gender, Politics, SES, Condition, DV) %>%
mutate(Survey = 5)
alldat <- rbind(dat2, dat4, dat5)
#Race_9 = Prefer not to say
#Coding racial variables
alldat <- alldat %>%
mutate(Race_1 = ifelse(is.na(Race_1), 0, Race_1),
Race_2 = ifelse(is.na(Race_2), 0, Race_2),
Race_3 = ifelse(is.na(Race_3), 0, Race_3),
Race_4 = ifelse(is.na(Race_4), 0, Race_4),
Race_5 = ifelse(is.na(Race_5), 0, Race_5),
Race_6 = ifelse(is.na(Race_6), 0, Race_6),
Race_7 = ifelse(is.na(Race_7), 0, Race_7),
Race_8 = ifelse(is.na(Race_8), 0, Race_8),
racesort = (Race_1 + Race_2 + Race_3 + Race_4 + Race_5 + Race_6 + Race_7),
na = ifelse(racesort < 1, 4, 0),
White = ifelse(Race_1 == 0 | racesort == 0 | racesort > 1, 0, 1),
Black = ifelse(Race_2 == 1, 2, 0),
RaceGroup = (White + Black + na),
RaceGroup = ifelse(RaceGroup < 1, 3, RaceGroup),
RaceGroup = ifelse(RaceGroup > 3, NA, RaceGroup))
# finally the race sorting works accurately! Urghh too forever; I wonder if there's a better way
# Make factor variables
alldat$Gender <- factor(alldat$Gender,
levels = c(1,2,3,4),
labels = c("Male", "Female", "Non-binary", "Transgender"))
alldat$Politics <- factor(alldat$Politics,
levels = c(1, 2, 3),
labels = c("Democrat", "Independent", "Republican"))
alldat$SES <- factor(alldat$SES,
levels = c(1,2,3,4,5),
labels = c("$10k and lower", "$10-41k", "$41-87k", "$87-165k", "$165k and above"))
alldat$Condition <- factor(alldat$Condition,
levels = c(1,2),
labels = c("Promotion Frame", "Prevention Frame"))
alldat$Survey <- as.factor(alldat$Survey)
alldat$RaceGroup <- factor(alldat$RaceGroup,
levels = c(1,2,3),
labels = c("White", "Black", "non-Black POC"))
#remove the individual racial columns
#also calculate average mindtypes for descriptives
cleandat <- alldat %>%
select(!starts_with("Race_") & !racesort & !na & !White & !Black) %>%
mutate(promotion = (pro1 + pro2 + pro3)/3,
prevention = (pre1 + pre2 + pre3)/3,
difference = promotion - prevention)
summary(cleandat)
## pro1 pro2 pro3 pre1 pre2
## Min. :1.000 Min. :1.000 Min. :1.00 Min. :1.000 Min. :1.000
## 1st Qu.:3.000 1st Qu.:3.000 1st Qu.:3.00 1st Qu.:2.000 1st Qu.:3.000
## Median :3.000 Median :3.000 Median :4.00 Median :3.000 Median :4.000
## Mean :3.137 Mean :3.093 Mean :3.29 Mean :2.809 Mean :3.509
## 3rd Qu.:4.000 3rd Qu.:4.000 3rd Qu.:4.00 3rd Qu.:4.000 3rd Qu.:4.000
## Max. :4.000 Max. :4.000 Max. :4.00 Max. :4.000 Max. :4.000
## pre3 Gender Politics SES
## Min. :1.000 Male :452 Democrat :396 $10k and lower :179
## 1st Qu.:3.000 Female :544 Independent:365 $10-41k :328
## Median :4.000 Non-binary : 21 Republican :234 $41-87k :324
## Mean :3.441 Transgender: 6 NA's : 34 $87-165k :137
## 3rd Qu.:4.000 NA's : 6 $165k and above: 23
## Max. :4.000 NA's : 38
## Condition DV Survey RaceGroup
## Promotion Frame :517 Min. :1.000 2:300 White :492
## Prevention Frame:511 1st Qu.:3.286 4:300 Black :265
## NA's : 1 Median :3.792 5:429 non-Black POC:246
## Mean :3.679 NA's : 26
## 3rd Qu.:4.286
## Max. :5.000
## promotion prevention difference
## Min. :1.000 Min. :1.000 Min. :-3.00000
## 1st Qu.:2.667 1st Qu.:3.000 1st Qu.:-0.33333
## Median :3.333 Median :3.333 Median : 0.00000
## Mean :3.173 Mean :3.253 Mean :-0.07969
## 3rd Qu.:3.667 3rd Qu.:3.667 3rd Qu.: 0.33333
## Max. :4.000 Max. :4.000 Max. : 2.66667
sd(cleandat$pro1)
## [1] 0.931339
sd(cleandat$pro2)
## [1] 0.9183832
sd(cleandat$pro3)
## [1] 0.8940458
sd(cleandat$pre1)
## [1] 1.030321
sd(cleandat$pre2)
## [1] 0.8638674
sd(cleandat$pre3)
## [1] 0.8708939
sd(cleandat$promotion)
## [1] 0.7817941
sd(cleandat$prevention)
## [1] 0.7175935
sd(cleandat$DV)
## [1] 0.8323799
library(ComplexHeatmap)
## Loading required package: grid
## ========================================
## ComplexHeatmap version 2.13.3
## Bioconductor page: http://bioconductor.org/packages/ComplexHeatmap/
## Github page: https://github.com/jokergoo/ComplexHeatmap
## Documentation: http://jokergoo.github.io/ComplexHeatmap-reference
##
## If you use it in published research, please cite either one:
## - Gu, Z. Complex Heatmap Visualization. iMeta 2022.
## - Gu, Z. Complex heatmaps reveal patterns and correlations in multidimensional
## genomic data. Bioinformatics 2016.
##
##
## The new InteractiveComplexHeatmap package can directly export static
## complex heatmaps into an interactive Shiny app with zero effort. Have a try!
##
## This message can be suppressed by:
## suppressPackageStartupMessages(library(ComplexHeatmap))
## ========================================
##
## Attaching package: 'ComplexHeatmap'
## The following object is masked from 'package:plotly':
##
## add_heatmap
library(circlize)
## ========================================
## circlize version 0.4.15
## CRAN page: https://cran.r-project.org/package=circlize
## Github page: https://github.com/jokergoo/circlize
## Documentation: https://jokergoo.github.io/circlize_book/book/
##
## If you use it in published research, please cite:
## Gu, Z. circlize implements and enhances circular visualization
## in R. Bioinformatics 2014.
##
## This message can be suppressed by:
## suppressPackageStartupMessages(library(circlize))
## ========================================
library(hopach)
## Loading required package: cluster
## Loading required package: Biobase
## Loading required package: BiocGenerics
##
## Attaching package: 'BiocGenerics'
## The following objects are masked from 'package:dplyr':
##
## combine, intersect, setdiff, union
## The following objects are masked from 'package:stats':
##
## IQR, mad, sd, var, xtabs
## The following objects are masked from 'package:base':
##
## anyDuplicated, append, as.data.frame, basename, cbind, colnames,
## dirname, do.call, duplicated, eval, evalq, Filter, Find, get, grep,
## grepl, intersect, is.unsorted, lapply, Map, mapply, match, mget,
## order, paste, pmax, pmax.int, pmin, pmin.int, Position, rank,
## rbind, Reduce, rownames, sapply, setdiff, sort, table, tapply,
## union, unique, unsplit, which.max, which.min
## Welcome to Bioconductor
##
## Vignettes contain introductory material; view with
## 'browseVignettes()'. To cite Bioconductor, see
## 'citation("Biobase")', and for packages 'citation("pkgname")'.
#only use the original items and not the average of mindtypes
#turn into z-scores
alldathm <- scale(cleandat[,c(1:6)])
# Color of heatmap
best_col <- colorRamp2(c(-2, 0, 2), c("#82A3FF", "grey", "#8B2E2E"))
#Heatmap with uncentered correlation & clustering with average linkage
uncenter.dist <- function(m){
as.dist(as.matrix(distancematrix(m, d="cosangle")))
}
row.clus <- hclust(uncenter.dist(alldathm), method = "ave")
col.clus <- hclust(uncenter.dist(t(alldathm)), method = "ave")
Heatmap(alldathm, name = "Mindtype",
column_title = "Mindtype Items", column_title_side = "bottom",
cluster_rows = row.clus, cluster_columns = col.clus,
col = best_col)
#some splittinggg
Heatmap(alldathm, name = "Mindtype",
column_title = "Mindtype Items", column_title_side = "bottom",
cluster_rows = row.clus, cluster_columns = col.clus,
column_split = 2,
col = best_col)
Heatmap(alldathm, name = "Mindtype",
column_title = "Mindtype Items", column_title_side = "bottom",
cluster_rows = row.clus, cluster_columns = col.clus,
column_split = 2, row_split = 6,
col = best_col)
### Heatmap Divided by Survey
#dat5 has different number of rows, cannot add to the other
#random sample of dat5
set.seed(1234)
dat5random <- dat5[sample(1:nrow(dat5), 300),]
dat2hm <- scale(dat2[,1:6])
dat4hm <- scale(dat4[,1:6])
dat5hm <- scale(dat5random[,1:6])
#Survey 2
row.clus2 <- hclust(uncenter.dist(dat2hm), method = "ave")
col.clus2 <- hclust(uncenter.dist(t(dat2hm)), method = "ave")
hmdat2 = Heatmap(dat2hm, name = "Survey 2",
cluster_rows = row.clus2, cluster_columns = col.clus2,
column_title = "Survey 2",
col = best_col)
hmdat2
# Survey 4
row.clus4 <- hclust(uncenter.dist(dat4hm), method = "ave")
col.clus4 <- hclust(uncenter.dist(t(dat4hm)), method = "ave")
hmdat4 = Heatmap(dat4hm, name = "Survey 4",
cluster_rows = row.clus4, cluster_columns = col.clus4,
column_title = "Survey 4",
col = best_col)
hmdat4
# Survey 5
row.clus5 <- hclust(uncenter.dist(dat5hm), method = "ave")
col.clus5 <- hclust(uncenter.dist(t(dat5hm)), method = "ave")
hmdat5 = Heatmap(dat5hm, name = "Survey 5",
cluster_rows = row.clus5, cluster_columns = col.clus5,
column_title = "Survey 5",
col = best_col)
hmdat5
hmdat2 + hmdat4 + hmdat5
#this was fun but not helpful
#maybe look at them individually survey-wise
#promotion vs. prevention orientation
cleandat %>%
filter(!is.na(Condition)) %>%
ggplot(mapping = aes(x = promotion, fill = Condition, color = Condition)) +
geom_density(alpha = 0.3) +
labs(x = "Average Promotion Mindtype", y = "Distribution") +
ggtitle("Density Plot of Promotion Mindtype, by Survey") +
theme_bw()
#not normal distribution
cleandat %>%
filter(!is.na(Condition)) %>%
ggplot(mapping = aes(x = prevention, fill = Condition, color = Condition)) +
geom_density(alpha = 0.3) +
labs(x = "Average Prevention Mindtype", y = "Distribution") +
ggtitle("Density Plot of Prevention Mindtype, by Survey") +
theme_bw()
#what a weird distribution shape
#hmm interesting that prevention frame distribution is not smooth
#difference scores between the mindtypes
#interactive!
plotdiff <- cleandat %>%
filter(!is.na(Survey) & !is.na(Condition)) %>%
ggplot(mapping = aes(x = difference, fill = Survey, color = Survey)) +
geom_density(alpha = 0.3) +
facet_wrap(~Condition) +
labs(x = "Promotion & Prevention Score Difference", y = "Distribution") +
ggtitle("Density Plot of Mindtypes, by Survey and Condition") +
theme_bw()
ggplotly(plotdiff)
#setting up
# Connected Dot Plot yayyy
col_dotplot <- c("#E69F00", "#0072B2", "#D55E00", "#56B4E9", "#800000")
Part of the following R codes for the connected dot plot are from Bowers et al., 2022. ### Politics
cleandat %>%
filter(!is.na(Politics)) %>%
group_by(Politics) %>%
dplyr::summarise(N = n(),
"Enhance everyone's health & wellbeing" = mean(pro1, na.rm = TRUE),
"Greater economic prosperity to area" = mean(pro2, na.rm = TRUE),
"Better future for next generation" = mean(pro3, na.rm = TRUE),
"Promotion Average" = mean(promotion, na.rm = TRUE),
"Militant/extreme members make it worse" = mean(pre1, na.rm = TRUE),
"Don't want loved ones to die/be harmed" = mean(pre2, na.rm = TRUE),
"End number of Americans killed/injured" = mean(pre3, na.rm = TRUE),
"Prevention Average" = mean(prevention, na.rm = TRUE)) %>%
pivot_longer(c("Enhance everyone's health & wellbeing",
"Greater economic prosperity to area",
"Better future for next generation",
"Promotion Average",
"Militant/extreme members make it worse",
"Don't want loved ones to die/be harmed",
"End number of Americans killed/injured",
"Prevention Average"),
names_to = "Item", values_to = "Mean") %>%
ggplot(aes(x = factor(Item, levels = rev(unique(Item)), ordered = TRUE),
y = Mean, size = N, fill = Politics)) +
scale_fill_manual(values = col_dotplot) +
geom_line(aes(group = Item), size = .2) +
geom_point(aes(size = N), shape = 21, alpha = .7) +
theme(legend.key.height = unit(1, 'cm'), legend.key.width = unit(1, 'cm')) +
ylim(1,4) +
labs(x = NULL, y = "Mean (Not At All - Extremely Motivating)",
title = "Mean by Political Groups") +
theme(plot.title = element_text(size = 5)) +
coord_flip() +
theme_bw()
cleandat %>%
filter(!is.na(RaceGroup)) %>%
group_by(RaceGroup) %>%
dplyr::summarise(N = n(),
"Enhance everyone's health & wellbeing" = mean(pro1, na.rm = TRUE),
"Greater economic prosperity to area" = mean(pro2, na.rm = TRUE),
"Better future for next generation" = mean(pro3, na.rm = TRUE),
"Promotion Average" = mean(promotion, na.rm = TRUE),
"Militant/extreme members make it worse" = mean(pre1, na.rm = TRUE),
"Don't want loved ones to die/be harmed" = mean(pre2, na.rm = TRUE),
"End number of Americans killed/injured" = mean(pre3, na.rm = TRUE),
"Prevention Average" = mean(prevention, na.rm = TRUE)) %>%
pivot_longer(c("Enhance everyone's health & wellbeing",
"Greater economic prosperity to area",
"Better future for next generation",
"Promotion Average",
"Militant/extreme members make it worse",
"Don't want loved ones to die/be harmed",
"End number of Americans killed/injured",
"Prevention Average"),
names_to = "Item", values_to = "Mean") %>%
ggplot(aes(x = factor(Item, levels = rev(unique(Item)), ordered = TRUE),
y = Mean, size = N, fill = RaceGroup)) +
scale_fill_manual(values = col_dotplot) +
geom_line(aes(group = Item), size = .2) +
geom_point(aes(size = N), shape = 21, alpha = .7) +
theme(legend.key.height = unit(1, 'cm'), legend.key.width = unit(1, 'cm')) +
ylim(1,4) +
labs(x = NULL, y = "Mean (Not At All - Extremely Motivating)",
title = "Mean by Racial Groups") +
theme(plot.title = element_text(size = 5)) +
coord_flip() +
theme_bw()
# wow this is important for the scale
#For prevention item #1 is significantly different for Black participants re: rating
#we need to revise this item
cleandat %>%
filter(Gender == c("Female", "Male")) %>%
group_by(Gender) %>%
dplyr::summarise(N = n(),
"Enhance everyone's health & wellbeing" = mean(pro1, na.rm = TRUE),
"Greater economic prosperity to area" = mean(pro2, na.rm = TRUE),
"Better future for next generation" = mean(pro3, na.rm = TRUE),
"Promotion Average" = mean(promotion, na.rm = TRUE),
"Militant/extreme members make it worse" = mean(pre1, na.rm = TRUE),
"Don't want loved ones to die/be harmed" = mean(pre2, na.rm = TRUE),
"End number of Americans killed/injured" = mean(pre3, na.rm = TRUE),
"Prevention Average" = mean(prevention, na.rm = TRUE)) %>%
pivot_longer(c("Enhance everyone's health & wellbeing",
"Greater economic prosperity to area",
"Better future for next generation",
"Promotion Average",
"Militant/extreme members make it worse",
"Don't want loved ones to die/be harmed",
"End number of Americans killed/injured",
"Prevention Average"),
names_to = "Item", values_to = "Mean") %>%
ggplot(aes(x = factor(Item, levels = rev(unique(Item)), ordered = TRUE),
y = Mean, size = N, fill = Gender)) +
scale_fill_manual(values = col_dotplot) +
geom_line(aes(group = Item), size = .2) +
geom_point(aes(size = N), shape = 21, alpha = .7) +
theme(legend.key.height = unit(1, 'cm'), legend.key.width = unit(1, 'cm')) +
ylim(1,4) +
labs(x = NULL, y = "Mean (Not At All - Extremely Motivating)",
title = "Mean by Gender") +
theme(plot.title = element_text(size = 5)) +
coord_flip() +
theme_bw()
cleandat %>%
filter(!is.na(SES)) %>%
group_by(SES) %>%
dplyr::summarise(N = n(),
"Enhance everyone's health & wellbeing" = mean(pro1, na.rm = TRUE),
"Greater economic prosperity to area" = mean(pro2, na.rm = TRUE),
"Better future for next generation" = mean(pro3, na.rm = TRUE),
"Promotion Average" = mean(promotion, na.rm = TRUE),
"Militant/extreme members make it worse" = mean(pre1, na.rm = TRUE),
"Don't want loved ones to die/be harmed" = mean(pre2, na.rm = TRUE),
"End number of Americans killed/injured" = mean(pre3, na.rm = TRUE),
"Prevention Average" = mean(prevention, na.rm = TRUE)) %>%
pivot_longer(c("Enhance everyone's health & wellbeing",
"Greater economic prosperity to area",
"Better future for next generation",
"Promotion Average",
"Militant/extreme members make it worse",
"Don't want loved ones to die/be harmed",
"End number of Americans killed/injured",
"Prevention Average"),
names_to = "Item", values_to = "Mean") %>%
ggplot(aes(x = factor(Item, levels = rev(unique(Item)), ordered = TRUE),
y = Mean, size = N, fill = SES)) +
scale_fill_manual(values = col_dotplot) +
geom_line(aes(group = Item), size = .2) +
geom_point(aes(size = N), shape = 21, alpha = .7) +
theme(legend.key.height = unit(1, 'cm'), legend.key.width = unit(1, 'cm')) +
ylim(1,4) +
labs(x = NULL, y = "Mean (Not At All - Extremely Motivating)",
title = "Mean by Socio-economic Status") +
theme(plot.title = element_text(size = 5)) +
coord_flip() +
theme_bw()
#even though we have a smaller pool for $165k+
#not surprising that the richest group has the
#least interest in greater economic prosperity to the area
#also number of people killed (decreased empathy?)
#Promotion
cleandat %>%
filter(!is.na(Politics) & !is.na(RaceGroup)) %>%
mutate(difference = promotion - prevention) %>%
ggplot(mapping = aes(x = difference)) +
geom_density(fill = "#82A3FF", alpha = 0.5) +
facet_grid(Politics ~ RaceGroup) +
labs(x = "Difference between Promotion & Prevention") +
theme_bw()
### Political Group and Gender
#DV
# Gender and Political Groups
cleandat %>%
filter(Gender == c("Male", "Female") & !is.na(Politics)) %>%
group_by(Gender, Politics) %>%
summarize(DV1 = mean(DV)) %>%
ggplot(mapping = aes(x = Politics, y = DV1, fill = Politics)) +
geom_point() +
ylim(1,5) +
labs(x = NULL, y = "Willingness to Engage", fill = "Political Group") +
guides(fill = FALSE) +
coord_flip() +
facet_wrap(~Gender) +
theme_bw()
## `summarise()` has grouped output by 'Gender'. You can override using the
## `.groups` argument.
First introduced in 1989 by Dr. Kimberlé Williams Crenshaw and adapted by Dr. Patricia Hill Collins a year later, intersectionality refers to how people experience different parts of their identities simultaneously instead of separately. For example, a Black queer woman experiences her life as Black, queer, and as a woman - we cannot fully separate these identities from one another.
cleandat %>%
filter(Gender == c("Male", "Female") & !is.na(RaceGroup)) %>%
mutate(difference = promotion - prevention) %>%
ggplot(mapping = aes(x = difference)) +
geom_density(fill = "#82A3FF", alpha = 0.5) +
facet_grid(Gender ~ RaceGroup) +
labs(x = "Difference between Promotion & Prevention") +
theme_bw()
#higher scores mean leaning more towards prevention
#don't have enough respondents for other groupings